home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_WINDW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-24  |  7.3 KB  |  285 lines
  1. UNIT GS_Windw;
  2.  
  3. {-----------------------------------------------------------------------------
  4.                               Window Handler
  5.  
  6.        GS_WINDW Copyright (c)  Richard F. Griffin
  7.  
  8.        15 November 1990
  9.        07 July 1991
  10.  
  11.        102 Molded Stone Pl
  12.        Warner Robins, GA  31088
  13.  
  14.        -------------------------------------------------------------
  15.        This unit handles creation of screen windows.
  16.  
  17.                    SHAREWARE  -- COMMERCIAL USE RESTRICTED
  18.  
  19.    Changes:
  20.              1 Apr 91  :  Inserted checks for monochrome monitors to avoid
  21.                           screen problems if the program attempts to set
  22.                           colors.  Changes are in GS_Wind_SetColors and
  23.                           InitWin.  The problem identification and fix were
  24.                           provided by John Haluska, El Segundo CA,
  25.                           CIS 74000,1106.
  26.  
  27.              7 Jul 91  :  Renamed from GS_Wind to GS_Windw to ensure all
  28.                           references to windows routines are preprocessed
  29.                           by GS_Winfc.  This will allow use of another
  30.                           windows handler instead of GS_Windw by changing
  31.                           the procedure calls and uses statement in GS_Winfc.
  32.  
  33. ------------------------------------------------------------------------------}
  34.  
  35. INTERFACE
  36. {$D-}
  37.  
  38. USES
  39.    Crt,
  40.    Dos,
  41.    GS_Scrn;
  42.  
  43. Type
  44.    GS_Wind_Str80  =  string[80];
  45.  
  46.    GS_Wind_Pntr   =  ^GS_Wind_Objt;
  47.  
  48.    GS_Wind_Objt   = Object
  49.                        x1,
  50.                        y1,
  51.                        x2,
  52.                        y2      :  integer;  {Window size}
  53.                        fg,                  {Foreground color}
  54.                        bg,                  {Background color}
  55.                        tx,                  {Text color}
  56.                        bgh,                 {Inverted background color}
  57.                        txh     :  byte;     {Inverted text color}
  58.                        CurX,                {Last X position when new window}
  59.                        CurY    :  integer;  {Last Y position when new window}
  60.                        dobox   :  boolean;  {Flag to draw a box option}
  61.                        boxname :  GS_Wind_Str80;
  62.                                             {Name for a box when drawn}
  63.                        copywin :  boolean;  {Flag to save old screen area}
  64.                                             {and restore when released}
  65.                        winpntr :  pointer;  {Storage for old screen area}
  66.                        lastwin :  GS_Wind_Pntr;
  67.                                             {Pointer to last window object}
  68.                        procedure MakBox;
  69.                        procedure InitWin (x1w,y1w,x2w,y2w : integer;
  70.                                           txw,bgw,fgw,txx,bgx : integer;
  71.                                           dbox : boolean;
  72.                                           bname : GS_Wind_Str80;
  73.                                           cpywin : boolean);
  74.                        procedure SetWin;
  75.                        procedure RelWin;
  76.                     end;
  77.  
  78. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  79. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  80. Procedure GS_Wind_SetNmMode;
  81. Procedure GS_Wind_SetFgMode;
  82. Procedure GS_Wind_SetIvMode;
  83. Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
  84.  
  85. implementation
  86.  
  87.  
  88. Var
  89.    win     :  GS_Wind_Objt;
  90.    Win_Ptr :  ^GS_Wind_Objt;
  91.    ok_win  :  boolean;
  92.    i       :  integer;
  93.  
  94. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  95. begin
  96.    with Win_Ptr^ do
  97.    begin
  98.       txw := tx;
  99.       bgw := bg;
  100.       fgw := fg;
  101.       txx := txh;
  102.       bgx := bgh;
  103.    end;
  104. end;
  105.  
  106. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  107. begin
  108.    with Win_Ptr^ do
  109.    if GS_Scrn_Mode <> Mono then
  110.    begin
  111.       tx  := txw;
  112.       bg  := bgw;
  113.       fg  := fgw;
  114.       txh := txx;
  115.       bgh := bgx;
  116.    end;
  117. end;
  118.  
  119. Procedure GS_Wind_SetNmMode;
  120. begin
  121.    with Win_Ptr^ do
  122.    begin
  123.       TextColor(tx);
  124.       TextBackground(bg);
  125.    end;
  126. end;
  127.  
  128. Procedure GS_Wind_SetFgMode;
  129. begin
  130.    with Win_Ptr^ do
  131.    begin
  132.       TextColor(fg);
  133.       TextBackground(bg);
  134.    end;
  135. end;
  136.  
  137. Procedure GS_Wind_SetIvMode;
  138. begin
  139.    with Win_Ptr^ do
  140.    begin
  141.       TextColor(txh);
  142.       TextBackground(bgh);
  143.    end;
  144. end;
  145.  
  146. Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
  147. begin
  148.    with Win_Ptr^ do
  149.    begin
  150.       wx1 := x1;
  151.       wy1 := y1;
  152.       wx2 := x2;
  153.       wy2 := y2;
  154.    end;
  155. end;
  156.  
  157. procedure GS_Wind_Objt.MakBox;
  158. var
  159.    wsmin,
  160.    wsmax     : word;
  161.    wscx,
  162.    wscy,
  163.    wsattr    : byte;
  164.    x, q      : integer;
  165.    s         : string;
  166.  
  167. begin
  168.    wsmin := WindMin;
  169.    wsmax := WindMax;
  170.    wsattr := TextAttr;
  171.    wscx := wherex;
  172.    wscy := wherey;
  173.    TextColor(fg);
  174.    window (1,1,80,25);
  175.    FillChar(s[1],80,#205);
  176.    x := succ(x2-x1);
  177.    s[0] := chr(x);
  178.    s[1] := #213;
  179.    if length(boxname) > 0 then
  180.    begin
  181.       if length(boxname) > x-2 then boxname[0] := chr(x-2);
  182.       x := (x-length(boxname)) div 2;
  183.       move(boxname[1],s[x+1],length(boxname));
  184.    end;
  185.    s[length(s)] := #184;
  186.    gotoxy(x1,y1);
  187.    write(s);
  188.    for q := y1+1 to y2-1 do
  189.    begin
  190.       gotoxy(x1,q);
  191.       write(#179);
  192.       gotoxy(x2,q);
  193.       write(#179);
  194.    end;
  195.    gotoxy(x1,y2);
  196.    FillChar(s[1],80,#205);
  197.    s[1] := #212;
  198.    s[0] := chr(pred(length(s)));
  199.    write(s);
  200.    GS_Scrn_Put_Char(x2,y2,#190);
  201.    WindMin := wsmin;
  202.    WindMax := wsmax;
  203.    TextAttr := wsattr;
  204.    gotoxy(wscx,wscy);
  205. end;
  206.  
  207. procedure GS_Wind_Objt.SetWin;
  208. begin
  209.    lastwin := win_ptr;
  210.    win_Ptr := @Self;
  211.    lastwin^.CurX := whereX;
  212.    lastwin^.CurY := wherey;
  213.    if copywin then
  214.       GS_Scrn_Get_Win(x1,y1,x2,y2,winpntr^);
  215.    TextColor(fg);
  216.    TextBackground(bg);
  217.    if dobox then
  218.    begin
  219.       MakBox;
  220.       window(x1+1, y1+1, x2-1, y2-1)
  221.    end else
  222.       window(x1, y1, x2, y2);
  223.    TextColor(tx);
  224.    ClrScr;
  225. end;
  226.  
  227. procedure GS_Wind_Objt.RelWin;
  228. begin
  229.    if copywin then
  230.       GS_Scrn_Put_Win(x1,y1,x2,y2,winpntr^);
  231.    win_Ptr := lastwin;
  232.    TextColor(lastwin^.tx);
  233.    TextBackground(lastwin^.bg);
  234.    if lastwin^.dobox then
  235.    begin
  236.       window(lastwin^.x1+1, lastwin^.y1+1, lastwin^.x2-1, lastwin^.y2-1)
  237.    end else
  238.       window(lastwin^.x1, lastwin^.y1, lastwin^.x2, lastwin^.y2);
  239.    gotoXY(lastwin^.CurX,lastwin^.CurY);
  240. end;
  241.  
  242.  
  243. procedure GS_Wind_Objt.InitWin(x1w,y1w,x2w,y2w : integer;
  244.                                txw,bgw,fgw,txx,bgx : integer;
  245.                                dbox : boolean;
  246.                                bname : GS_Wind_Str80;
  247.                                cpywin : boolean);
  248. var
  249.    i,x,q   :  integer;
  250. begin
  251.    x1 := x1w;
  252.    y1 := y1w;
  253.    x2 := x2w;
  254.    y2 := y2w;
  255.    if GS_Scrn_Mode = Mono then
  256.    begin
  257.       fg := LightGray;
  258.       bg := Black;
  259.       tx := LightGray;
  260.       txh := Black;
  261.       bgh := LightGray;
  262.    end
  263.    else
  264.    begin
  265.       fg := fgw;
  266.       bg := bgw;
  267.       tx := txw;
  268.       txh := txx;
  269.       bgh := bgx;
  270.    end;
  271.    dobox := dbox;
  272.    boxname := bname;
  273.    copywin := cpywin;
  274.    if cpywin then
  275.       GetMem(winpntr,(((x2-x1)+1) * ((y2-y1)+1)) * 2)
  276.    else winpntr := nil;
  277. end;
  278.  
  279. begin
  280.    win.InitWin (1,1,80,25,7,0,7,0,7,FALSE,'',FALSE);
  281.    win_ptr := @win;
  282.    win.SetWin;
  283.    win.lastwin := win_Ptr;
  284. end.
  285.